home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / memptr.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  2KB  |  83 lines
  1. /* memptr.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /*<       logical function memptr(ipntr) >*/
  20. logical memptr_(ipntr)
  21. integer *ipntr;
  22. {
  23.     /* System generated locals */
  24.     integer i_1;
  25.     logical ret_val;
  26.  
  27.     /* Local variables */
  28.     extern integer locf_();
  29.     static integer i, locpnt;
  30.  
  31.     /* Parameter adjustments */
  32.     --ipntr;
  33.  
  34.     /* Function Body */
  35. /*<       implicit double precision (a-h,o-z) >*/
  36.  
  37. /*      this routine checks whether *ipntr* is a valid block pointer. */
  38. /* if it is valid, *ltab* is set to point to the corresponding entry in */
  39.  
  40. /* the block table. */
  41.  
  42. /* ... ipntr is an array to avoid 'call by value' problems (see setmem) */
  43.  
  44. /*<       dimension ipntr(1) >*/
  45. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  46. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  47. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  48. /*<      2   nwd8,nwd16 >*/
  49. /*<       memptr=.false. >*/
  50.     ret_val = FALSE_;
  51. /*<       ltab=loctab >*/
  52.     memmgr_1.ltab = memmgr_1.loctab;
  53. /*<       locpnt=locf(ipntr(1)) >*/
  54.     locpnt = locf_(&ipntr[1]);
  55. /*<       do 20 i=1,numblk >*/
  56.     i_1 = memmgr_1.numblk;
  57.     for (i = 1; i <= i_1; ++i) {
  58. /*<       if (locpnt.ne.istack(ltab+4)) go to 10 >*/
  59.     if (locpnt != memmgr_1.istack[memmgr_1.ltab + 3]) {
  60.         goto L10;
  61.     }
  62. /*<       if (ipntr(1)*istack(ltab+5).ne.istack(ltab+1)) go to 10 >*/
  63.     if (ipntr[1] * memmgr_1.istack[memmgr_1.ltab + 4] != memmgr_1.istack[
  64.         memmgr_1.ltab]) {
  65.         goto L10;
  66.     }
  67. /*<       memptr=.true. >*/
  68.     ret_val = TRUE_;
  69. /*<       go to 30 >*/
  70.     goto L30;
  71. /*<    10 ltab=ltab+ntab >*/
  72. L10:
  73.     memmgr_1.ltab += memmgr_1.ntab;
  74. /*<    20 continue >*/
  75. /* L20: */
  76.     }
  77. /*<    30 return >*/
  78. L30:
  79.     return ret_val;
  80. /*<       end >*/
  81. } /* memptr_ */
  82.  
  83.